home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / tcsel003.zip / ENCRYPT.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-16  |  8KB  |  233 lines
  1. {$A+,B-,D-,E+,F-,G+,I+,L-,N-,O-,R-,S-,V-,X+}
  2. {$M 4048,0,131040}
  3. program encrypt;
  4.  
  5. { Author Trevor J Carlsen - released into the public domain 1992         }
  6. {        PO Box 568                                                      }
  7. {        Port Hedland                                                    }
  8. {        Western Australia 6721                                          }
  9. {        Voice +61 91 73 2026  Data +61 91 73  2569                      }
  10. {        FidoNet 3:690/644                                               }
  11.  
  12. { Syntax: encrypt /p=Password /k=Keyfile /f=File                         }
  13. { Example -                                                              }
  14. {         encrypt /p=billbloggs /k=c:\command.com /f=p:\prog\anyfile.pas }
  15.  
  16. {         Password can be any alpha-numeric sequence of AT LEAST four    }
  17. {         characters.                                                    }
  18.  
  19. {         Keyfile is the full path of any file on the system that this   }
  20. {         program runs on.  This file, preferably a large one, must not  }
  21. {         be subject to changes.  This is critical as it is used as a    }
  22. {         pseudo "one time pad" style key and the slightest change will  }
  23. {         render decryption invalid.                                     }
  24.  
  25. {         File is the full path of the file to be encrypted or decrypted.}
  26.  
  27. { Notes:  Running Encrypt a second time with exactly the same parameters }
  28. {         decrypts an encrypted file.  For total security the keyfile    }
  29. {         can be stored separately on a floppy.  Without this keyfile or }
  30. {         knowledge of its contents it is IMPOSSIBLE to decrypt the      }
  31. {         encrypted file.                                                }
  32.  
  33. {         Parameters are case insensitive and may be in any order and    }
  34. {         may not contain any dos separator characters.                  }
  35.  
  36. const
  37.   BufferSize   = 65520;
  38.   Renamed      : boolean = false;
  39.  
  40. type
  41.   buffer_      = array[0..BufferSize - 1] of byte;
  42.   buffptr      = ^buffer_;
  43.   str80        = string[80];
  44.  
  45. var
  46.   OldExitProc  : pointer;
  47.   KeyFile,
  48.   OldFile,
  49.   NewFile      : file;
  50.   KeyBuffer,
  51.   Buffer       : buffptr;
  52.   KeyFileSize,
  53.   EncFileSize  : longint;
  54.   Password,
  55.   KFName,
  56.   FFName       : str80;
  57.  
  58. procedure Hash(p : pointer; numb : byte; var result: longint);
  59.   { When originally called numb must be equal to sizeof    }
  60.   { whatever p is pointing at.  If that is a string numb   }
  61.   { should be equal to length(the_string) and p should be  }        
  62.   { ptr(seg(the_string),ofs(the_string)+1)                 }
  63.   var
  64.     temp,
  65.     w    : longint;
  66.     x    : byte;
  67.  
  68.   begin
  69.     temp := longint(p^);  RandSeed := temp;
  70.     for x := 0 to (numb - 4) do begin
  71.       w := random(maxint) * random(maxint) * random(maxint);
  72.       temp := ((temp shr random(16)) shl random(16)) +
  73.                 w + MemL[seg(p^):ofs(p^)+x];
  74.     end;
  75.     result := result xor temp;
  76.   end;  { Hash }
  77.  
  78. procedure NewExitProc; far;
  79.   { Does the "housekeeping" necessary on program termination }
  80.   var code : integer;
  81.   begin
  82.     ExitProc := OldExitProc;  { Reset exit procedure pointer to original }
  83.     case ExitCode of
  84.     0: writeln('Successfully encrypted or decrypted ',FFName);
  85.     1: begin
  86.          writeln('This program requires 3 parameters -');
  87.          writeln('  /pPassword');
  88.          writeln('  /kKeyFile (full path and name)');
  89.          write  ('  /fFile (The full path and name of the file');
  90.          writeln(' to be processed)');
  91.          writeln;
  92.          write  ('These parameters can be in any order, are case,');
  93.          writeln(' insensitive, and may not contain any spaces.');
  94.        end;
  95.     2: writeln('Could not find key file');
  96.     3: writeln('Could not rename and/or open original file');
  97.     4: writeln('Could not create encrypted file');
  98.     5: writeln('I/O error during processing - could not complete');
  99.     6: writeln('Insufficient memory available');
  100.     7: begin
  101.          writeln('Key  file is too small - aborted');
  102.          writeln;
  103.          writeln(' Key File must be at least as large as the buffer size ');
  104.          write  (' or the size of the file to be encrypted, whatever is the');
  105.          writeln(' smaller.');
  106.        end;
  107.     8: writeln('Password must consist of at least 4 characters');
  108.     else { any other error }
  109.       writeln('Aborted with error ',ExitCode);
  110.     end; { case }
  111.     if Renamed and (ExitCode <> 0) then
  112.       writeln(#7'WARNING: Original file''s name is now TEMP.$$$');
  113.     {$I-}
  114.     close(KeyFile); Code := IOResult;
  115.     close(NewFile); Code := IOResult;
  116.     close(OldFile); Code := IOResult;
  117.     if ExitCode = 0 then
  118.       Erase(OldFile); Code := IOResult;
  119.     {$I+}
  120.   end; { NewExitProc }
  121.  
  122.  
  123. function Str2UpCase(var S: string): string;
  124.   { Converts a string S to upper case.  Valid for English. }
  125.   var
  126.     x : byte;
  127.   begin
  128.     Str2UpCase[0] := S[0];
  129.     for x := 1 to length(S) do
  130.       Str2UpCase[x] := UpCase(S[x]);
  131.   end; { Str2UpCase }
  132.  
  133. procedure Initialise;
  134.   var
  135.     CommandLine : string;
  136.     FPos,FLen,
  137.     KPos,KLen,
  138.     PPos,PLen   : byte;
  139.  
  140.   procedure  AllocateMemory(var p: buffptr; size: longint);
  141.     begin
  142.       if size < BufferSize then begin
  143.         if MaxAvail < size then halt(6);
  144.         GetMem(p,size);
  145.       end
  146.       else begin
  147.         if MaxAvail < BufferSize then halt(6);
  148.         new(p);
  149.       end;
  150.     end; { AllocateMemory }
  151.  
  152.   begin
  153.     FillChar(OldExitProc,404,0);       { Initialise all global variables }
  154.     FillChar(Password,243,32);
  155.     ExitProc    := @NewExitProc;             { Set up new exit procedure }
  156.     if ParamCount <> 3 then halt(1);
  157.     CommandLine := string(ptr(PrefixSeg,$80)^)+' '; { Add trailing space }
  158.     CommandLine := Str2UpCase(CommandLine);      { Convert to upper case }
  159.     PPos        := pos('/P=',CommandLine);     { Find password parameter }
  160.     KPos        := pos('/K=',CommandLine);      { Find keyfile parameter }
  161.     FPos        := pos('/F=',CommandLine); { Find filename for encryption}
  162.     if (PPos = 0) or (KPos = 0) or (FPos = 0) then Halt(1);
  163.     FFName      := copy(CommandLine,FPos+3,80);
  164.     FFName[0]   := chr(pos(' ',FFName)-1);       { Correct string length }
  165.     KFName      := copy(CommandLine,KPos+3,80);
  166.     KFName[0]   := chr(pos(' ',KFName)-1);
  167.     Password    := copy(CommandLine,PPos+3,80);
  168.     Password[0] := chr(pos(' ',Password)-1);
  169.     if length(Password) < 4 then halt(8);
  170.     { Create a random seed value based on the password }
  171.     Hash(ptr(seg(Password),ofs(Password)+1),length(Password),RandSeed);
  172.     assign(OldFile,FFName);
  173.     {$I-}
  174.     rename(OldFile,'TEMP.$$$');
  175.     if IOResult <> 0 then
  176.       halt(3)
  177.     else
  178.       renamed := true;
  179.     assign(OldFile,'TEMP.$$$');
  180.     reset(OldFile,1);
  181.     if IOResult <> 0 then halt(3);
  182.     assign(NewFile,FFName);
  183.     rewrite(NewFile,1);
  184.     if IOResult <> 0 then halt(4);
  185.     assign(KeyFile,KFName);
  186.     reset(KeyFile,1);
  187.     if IOResult <> 0 then halt(2);
  188.     EncFileSize := FileSize(OldFile);
  189.     KeyFileSize := FileSize(KeyFile);
  190.     if KeyFileSize > EncFileSize then
  191.       KeyFileSize := EncFileSize;
  192.     if IOResult <> 0 then halt(5);
  193.     {$I+}
  194.     if (KeyFileSize < BufferSize) and (KeyFileSize < EncFileSize) then
  195.       halt(7);
  196.     AllocateMemory(buffer,EncFileSize);
  197.     AllocateMemory(KeyBuffer,KeyFileSize);
  198.   end; { Initialise }
  199.  
  200. procedure Main;
  201.   var
  202.     BytesRead : word;
  203.     finished  : boolean;
  204.  
  205.   procedure CodeBuffer(number: word);
  206.     { This is the actual encryption/decryption engine }
  207.     var x : word;
  208.     begin
  209.       for x := 0 to number - 1 do
  210.         buffer^[x] := buffer^[x] xor KeyBuffer^[x] xor Random(256);
  211.     end; { CodeBuffer }
  212.  
  213.   begin
  214.     {$I-}
  215.     finished := false;
  216.     repeat
  217.       BlockRead(OldFile,buffer^,BufferSize,BytesRead);
  218.       if IOResult <> 0 then halt(5);
  219.       if (FilePos(KeyFile) + BytesRead) > KeyFileSize then
  220.         seek(KeyFile,0);
  221.       BlockRead(KeyFile,KeyBuffer^,BytesRead,BytesRead);
  222.       if IOResult <> 0 then halt(5);
  223.       CodeBuffer(BytesRead);
  224.       finished := BytesRead < BufferSize;
  225.       BlockWrite(NewFile,buffer^,BytesRead);
  226.     until finished;
  227.   end;  { Main }
  228.  
  229. begin
  230.   Initialise;
  231.   Main;
  232. end.
  233.